-----------------------------------------------------------------------------
--
-- Module      :  Data.Unit.Instances
-- Copyright   :
-- License     :  AllRightsReserved
--
-- Maintainer  :
-- Stability   :
-- Portability :
--
-- Metric System definition
--
-----------------------------------------------------------------------------
{-# LANGUAGE MultiParamTypeClasses, ScopedTypeVariables,
FlexibleInstances, FlexibleContexts, TypeOperators  #-}


module Data.Unit.Instances
(

 MApplicative(..),

 UNum(..),
 UFractional(..),
-- UNum2(..),
-- UFractional2(..),


 UMNumber(..),
 unify,
 (<:),

 (:<:)(..),
 (:<<:),

) where

import qualified Prelude as P
import Prelude (Show(..), Integer, Double, undefined, (==))
import Data.Function (($), (.))
import Data.List ((++))
import Data.Functor
import Control.Applicative

import Data.Unit.Types



----------
newtype UMNumber m n = UMNumber { toNum :: n }

instance (Show n, Show m) => Show (UMNumber m n) where
    show n = show (toNum n) ++ "<" ++ (if sm == "1" then "" else sm) ++ ">"
        where sm = show (undefined::m)

instance Functor (UMNumber m) where
    fmap f = UMNumber . f . toNum

instance Applicative (UMNumber m) where
    pure = UMNumber
    f <*> n = UMNumber $ (toNum f $ toNum n)

instance MApplicative UMNumber where
    mpure = UMNumber
    f <***> n = UMNumber $ (toNum f $ toNum n)

type n :<<: m = UMNumber m n

---
newtype n :<: m = Un { unwrap :: n }

instance (Show n, Show m) => Show (n :<: m) where
    show n = show (unwrap n) ++ "<" ++ (if sm == "1" then "" else sm) ++ ">"
        where sm = show (undefined::m)
{-
instance Functor (:<: m) where
    fmap f = UMNumber . f . toNum

instance Applicative (UMNumber m) where
    pure = UMNumber
    f <*> n = UMNumber $ (toNum f $ toNum n)
-}
instance MApplicative2 (:<:) where
    mpure2 = Un
    f <****> n = Un $ (unwrap f $ unwrap n)



----
{-
unify :: n -> UMNumber m n
unify = UMNumber

constant :: n -> UMNumber U n
constant n = UMNumber n
-}

unify :: n -> n :<: m
unify = Un

constant :: n -> n :<: U
constant = Un

infixl 9 <:

--(<:) :: n -> (UMNumber m n) -> UMNumber m n
--(<:) :: UNum UMNumber n => n -> (UMNumber m n) -> UMNumber m n
n <: u = constant n * u

--------------

infixl 7  *
infixl 6  +, -

{-
class UNum a b where
    (-) :: (Minus m1 m2 r) => a m1 b -> a m2 b -> a r b
    (+) :: (Plus m1 m2 r) => a m1 b -> a m2 b -> a r b
    (*) :: (Multiply m1 m2 r) => a m1 b -> a m2 b -> a r b 
    negate :: a m b -> a m b


instance (P.Num n) => UNum UMNumber n where
    (+) = mlift2M (P.+)
    (-) = mlift2M (P.-)
    (*) = mlift2M (P.*)
    negate = fmap P.negate 
-}

class UNum u where
    (-) :: (Minus m1 m2 r) => u m1 -> u m2 -> u r
    (+) :: (Plus m1 m2 r) => u m1 -> u m2 -> u r
    (*) :: (Multiply m1 m2 r) => u m1 -> u m2 -> u r 
    negate :: u m -> u m

instance (P.Num n) => UNum ((:<:) n) where
    (+) = mlift2M2 (P.+)
    (-) = mlift2M2 (P.-)
    (*) = mlift2M2 (P.*)
    negate v = mpure2 P.negate <****> v 
    

-------------

infixl 7  /
{-
class (UNum a b) => UFractional a b where
    (/) :: (Divide m1 m2 r) => a m1 b -> a m2 b -> a r b

instance (P.Fractional n) => UFractional UMNumber n where
    (/) = mlift2M (P./)
-}

class (UNum u) => UFractional u where
    (/) :: (Divide m1 m2 r) => u m1 -> u m2 -> u r

instance (P.Fractional n) => UFractional ((:<:) n) where
    (/) = mlift2M2 (P./)

